perm filename MAPS1.LST[SYS,HE] blob
sn#062654 filedate 1973-09-17 generic text, type T, neo UTF8
M SAIL 17-SEP-73 13:23 MAPS1 1-1
M
␈BβπCOMMENT␈A007502 00037 COMMENT ⊗ VALID 00016 PAGES
007502 00002 C REC PAGE DESCRIPTION
007502 00003 C00001 00001
007502 00004 C00002 00002 MAPS1 - programs for the parsing of the scene.
007502 00005 C00006 00003 _ external and forward procedures - LCRV
007502 00006 C00008 00004 _ DTRCE, LINDL, QTRCE
007502 00007 C00010 00005 _ MLCR, REVIVE, UPPDAL
007502 00008 C00012 00006 _ UNTST, BREAK
007502 00009 C00014 00007 _ CLUPSC
007502 00010 C00017 00008 _ FUSABL
007502 00011 C00021 00009 _ LFDIF
007502 00012 C00026 00010 _ MAP (VCRKEY)
007502 00013 C00030 00011 _ PARSE
007502 00014 C00033 00012 _ PARSE cont
007502 00015 C00035 00013 _ PARSE cont
007502 00016 C00038 00014 _ PARSE cont
007502 00017 C00040 00015 _ PARSE cont
007502 00018 C00042 00016 _ PARSE cont
007502 00019 C00045 ENDMK
007502 00020 C⊗;
M SAIL 17-SEP-73 13:23 MAPS1 2-1
M
␈BβπCOMMENT␈A007502 00021
COMMENT MAPS1 - programs for the parsing of the scene.;
007502 00002
␈Bβ¬ENTRY␈A007502 00003 ENTRY LCRV,LCRL,DTRCE,LINDL,QTRCE,MLCR,REVIVE,CLUPSC,
007502 00004 UPPDAL,FUSABL,LFDIF,MAP,PARSE;
007502 00005
␈Bβ¬BEGIN↓ε070073α↓ε070121α↓ε070147α↓ε070162α↓ε070210α↓ε070223α↓ε070251α
¬MAPS1␈A007502 00006 BEGIN "MAPS1"
007502 00007
␈B↓ε070325αεε070401εε070427␈A007502 00008 DEFINE QC(I)="&"" I=""&CVS(I)",
␈Bεε070414εε070455␈A007502 00009 QCO(I)="&"" I=""&CVOS(I)",
␈Bεε070427εε070503␈A007502 00010 QCR(R)="&"" R=""&CVF(R)",
␈Bεε070455␈A007502 00011 NOTHING="",
␈Bεε070544␈A007502 00012 CL="'15&'12",
␈Bεε070557␈A007502 00013 QSCOR="&"" SCORE=""&CVOS(CMPL+1)&""/""&CVOS(SCO)",
␈Bεε070605␈A007502 00014 BL="'40",
␈Bεε070633␈A007502 00015 QENP="EXTERNAL PROCEDURE",
␈Bεε070661␈A007502 00016 QS="STRING",
␈Bεε070707␈A007502 00017 QESP="EXTERNAL SIMPLE STRING PROCEDURE",
␈Bεε070735␈A007502 00018 QI="INTEGER",
␈Bεε070763␈A007502 00019 QR="REAL",
␈Bεε071011␈A007502 00020 QRI="REFERENCE INTEGER",
␈Bεε071037␈A007502 00021 QRR="REFERENCE REAL",
␈Bεε071065␈A007502 00022 QEP="EXTERNAL SIMPLE PROCEDURE",
␈Bεε071113␈A007502 00023 QEIP="EXTERNAL SIMPLE INTEGER PROCEDURE",
␈Bεε071141␈A007502 00024 QERP="EXTERNAL SIMPLE REAL PROCEDURE",
␈Bεε071167␈A007502 00025 QFOP="FORWARD INTERNAL SIMPLE PROCEDURE",
␈Bεε071215␈A007502 00026 QFOIP="FORWARD INTERNAL SIMPLE INTEGER PROCEDURE",
␈Bεε071243␈A007502 00027 QFORP="FORWARD INTERNAL SIMPLE REAL PROCEDURE",
␈Bεε071271␈A007502 00028 _="COMMENT",
␈Bεε071317εε071360εε071373εε071406εε071421␈A007502 00029 LOOP(I,J,K,L)="FOR I←J STEP L UNTIL K DO",
␈Bεε071345␈A007502 00030 QTRC="IF DTRACE∨MAPTRC LAND '12000 THEN QTRCE",
␈Bεε071421␈A007502 00031 DTRC="IF DTRACE∨MAPTRC LAND '10000 THEN DTRCE",
␈Bεε071373␈A007502 00032 LINSET="DISW←1; DTRC(""LINSRT:""QC(IFREEL)); LINSRT",
␈Bεε071447εε071510␈A007502 00033 BELCRE(I)="LVNEXT(I,-1)",
␈Bεε071475␈A007502 00034 SAFEX="SAFE";
␈BβπINTEGER↓ε071510α↓ε071551α↓ε071564α␈A007502 00035 INTEGER IA,DCHAN,CURMAP;
␈BβλINTERNALβπINTEGER↓ε071577α↓ε071612α↓ε071625α↓ε071640α↓ε071653α↓ε071666α↓ε071701α↓ε071714α↓ε071727α␈A007502 00036 INTERNAL INTEGER PROT,PLIN,PVER,AD0,LNCS1,LNCS2,RAYS,ICH,CMPIND,
␈B↓ε071742α↓ε071755α↓ε071770α↓ε072003α↓ε072016α↓ε072031α↓ε072044α↓ε072057α↓ε072072α↓ε072105α↓ε072120α↓ε072133α␈A007502 00037 BRCH,EOF,DTRACE,KMP,RUL,MDCTR,DISW,FLMIND,FTSW,LFDBT,BESTMP,NPRS,
␈B↓ε072146α↓ε072161α↓ε072174α↓ε072207α↓ε072222α␈A007502 00038 N1,N2,TC,TCS,LNCRE0;
␈BβλEXTERNALβπINTEGER↓ε072235α↓ε072250α↓ε072263α↓ε072276α↓ε072311α↓ε072324α␈A007502 00039 EXTERNAL INTEGER NOEPA,NOL,MAXNOL,MAXNOV,LNCRE1,LNCRE2,
␈B↓ε072337α↓ε072352α↓ε072365α↓ε072400α↓ε072413α↓ε072426α↓ε072441α↓ε072454α␈A007502 00040 PFTOT,MODIF,PLFTOT,MAXPLS,MAXPVS,MAPTRC,SCO,CMPL;
␈BβλEXTERNALβ∧REAL↓ε072467α↓ε072502α␈A007502 00041 EXTERNAL REAL RWIC,RMAP;
␈B¬ε071475β∧SAFEβλEXTERNALβπINTEGERβ¬ARRAY↓ε072515α↓ε072543α↓ε072556α↓ε072571α↓ε072604α␈A007502 00042 SAFEX EXTERNAL INTEGER ARRAY DICH[0:1],LCREDE,LFEAT,LVERCO,LINK,
␈B↓ε072617α↓ε072632α↓ε072645α↓ε072660α↓ε072673α↓ε072706α↓ε072721α↓ε072747α␈A007502 00043 LVERSI,PLINES,PVERTS,PPTRL,PLINE,PLINE2,PFPRO,PFEAT,
␈B↓ε072762α↓ε072775α↓ε072734α␈A007502 00044 LVER,CFEAT[1:1],PFPTR[0:1];
␈B¬ε071475β∧SAFEβλEXTERNALβ∧REALβ¬ARRAY↓ε073010α↓ε073023α↓ε073036α↓ε073051α↓ε073064α↓ε073077α↓ε073112α↓ε073125α␈A007502 00045 SAFEX EXTERNAL REAL ARRAY XVCOR,YVCOR,XLCOR,YLCOR,CXL,CYL,CCL,RLEN[1:1];
␈B¬ε071475β∧SAFEβλEXTERNALβεSTRINGβ¬ARRAY↓ε073140α␈A007502 00046 SAFEX EXTERNAL STRING ARRAY PNAME[1:1];
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 3-1
MAPS1
␈B¬ε071271βπCOMMENT␈A007502 00047
_ external and forward procedures - LCRV;
007502 00002
␈B¬ε071065βλEXTERNALβεSIMPLEβ PROCEDURE↓ε073153α ε073227↓I ε073242↓J␈A007502 00003 QEP LINDEL(QI I,J);
␈B¬ε071113βλEXTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε073214α ε073303↓I ε073316↓J ε073331↓K␈A007502 00004 QEIP BITS(QI I,J,K);
␈B¬ε071113βλEXTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε073270α ε073372¬CODES␈A007502 00005 QEIP MAPCONV(QS CODES);
␈B¬ε071113βλEXTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε073357α ε073433↓X ε073446↓Y␈A007502 00006 QEIP INREK(QR X,Y);
␈B¬ε071065βλEXTERNALβεSIMPLEβ PROCEDURE↓ε073420α␈A007502 00007 QEP UPPDAT;
␈B¬ε071065βλEXTERNALβεSIMPLEβ PROCEDURE↓ε073474α␈A007502 00008 QEP FTEX;
␈B¬ε070633βλEXTERNALβ PROCEDURE↓ε073522α ε073576↓I␈A007502 00009 QENP XREFC(QI I);
␈B¬ε071065βλEXTERNALβεSIMPLEβ PROCEDURE↓ε073563α␈A007502 00010 QEP UNXREF;
␈B¬ε071113βλEXTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε073624α ε073665↓I␈A007502 00011 QEIP LACT(QI I);
␈B¬ε071141βλEXTERNALβεSIMPLEβ∧REALβ PROCEDURE↓ε073652α ε073726↓I ε073741↓J␈A007502 00012 QERP ANGLIN(QI I,J);
␈B¬ε071113βλEXTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε073713α ε074002↓I␈A007502 00013 QEIP LVOPP(QI I);
␈B¬ε071141βλEXTERNALβεSIMPLEβ∧REALβ PROCEDURE↓ε073767α ε074043↓R␈A007502 00014 QERP SQRT(QR R);
␈B¬ε071113βλEXTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε074030α ε103742↓I ε103755↓J␈A007502 00015 QEIP MAX0(QI I,J);
␈B¬ε071113βλEXTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε103727α ε104016αX1 ε104031αY1 ε104044αX2 ε104057αY2 ε104072αX3 ε104105αY3 ε104120αX4 ε104133αY4 ε104146αIC␈A007502 00016 QEIP KARN(QR X1,Y1,X2,Y2,X3,Y3,X4,Y4; QI IC);
␈B¬ε071065βλEXTERNALβεSIMPLEβ PROCEDURE↓ε104003α ε104207αX1 ε104222αY1 ε104235αX2 ε104250αY2 ε104263αWI ε104276αRL␈A007502 00017 QEP REKOP(QR X1,Y1,X2,Y2,WI; QRR RL);
␈B¬ε071065βλEXTERNALβεSIMPLEβ PROCEDURE↓ε104174α ε104337↓I ε104352↓X ε104365↓Y ε104400αWE␈A007502 00018 QEP WEIGHV(QI I; QRR X,Y,WE);
␈B¬ε071113βλEXTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε104324α␈A007502 00019 QEIP MAPREC;
␈B¬ε071065βλEXTERNALβεSIMPLEβ PROCEDURE↓ε104426α␈A007502 00020 QEP PRECAL;
␈B¬ε071065βλEXTERNALβεSIMPLEβ PROCEDURE↓ε104454α␈A007502 00021 QEP CALC;
␈B¬ε071113βλEXTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε104502α ε104543↓I ε104556↓J␈A007502 00022 QEIP LVNEXT(QI I,J);
␈B¬ε071065βλEXTERNALβεSIMPLEβ PROCEDURE↓ε104530α ε104617↓I␈A007502 00023 QEP REGREF(INTEGER I);
␈B¬ε071113βλEXTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε104604α ε104660βISV ε104673βICV ε104706∧LADD␈A007502 00024 QEIP MSCVCO(QI ISV, ICV, LADD);
␈B¬ε071113βλEXTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε104645α␈A007502 00025 QEIP NEXVER;
␈B¬ε071113βλEXTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε104734α ε104775↓L␈A007502 00026 QEIP LCRL(QI L);
007502 00027
␈B¬ε071271βπCOMMENT␈A007502 00028 _ return LCREDE entry for s.v. SV (sign and low 4 octal digits only);
007502 00029
␈BβλINTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε104762α
∧LCRVβπINTEGER↓ε105036α␈A007503 00030 INTERNAL SIMPLE INTEGER PROCEDURE LCRV(INTEGER SV);
␈BβεRETURN↓ε072543↓ε105036β∧LAND∞∧LCRV ε105036αSV␈A007517 00031 RETURN(LCREDE[(SV+1)%2] LAND '400000007777);
007517 00032
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 4-1
MAPS1
␈B¬ε071271βπCOMMENT␈A007517 00033
_ DTRCE, LINDL, QTRCE;
007517 00002
␈B¬ε071271βπCOMMENT␈A007517 00003 _ Produces trace output on file "PARSE.TRC" if MAPREC bit 12 is set.;
007517 00004
␈BβλINTERNALβεSIMPLEβ PROCEDURE↓ε105023α
¬DTRCEβεSTRING↓ε105125α␈A007517 00005 INTERNAL SIMPLE PROCEDURE DTRCE(STRING S);
␈Bβ¬BEGIN
∧DTRC␈A007517 00006 BEGIN "DTRC"
␈BβαIF↓ε071770↓ε071551↓ε071770↓ε071770↓ε072426β∧LANDβ∧THEN␈A007532 00007 IF DTRACE∧DCHAN=-1∨¬DTRACE∧(DTRACE←MAPTRC LAND '10000) THEN
␈Bβ¬BEGIN␈A007532 00008 BEGIN
␈B↓ε015113↓ε071551↓ε016467↓ε071742↓ε071755␈A007546 00009 OPEN(DCHAN←GETCHAN,"DSK",0,0,2,100,BRCH,EOF);
␈B↓ε015335↓ε071551↓ε015167↓ε072133↓ε072133↓ε071510␈A007564 00010 ENTER(DCHAN,"PARS"&CVS(NPRS←NPRS+1)&".TRC",IA)
␈BββEND␈A007564 00011 END;
␈BβαIF↓ε071770↓ε071770↓ε072426β∧LANDβ∧THEN␈A007572 00012 IF DTRACE∧¬(DTRACE←MAPTRC LAND '10000) THEN
␈Bβ¬BEGIN↓ε015260↓ε071551↓ε071551ββEND␈A007576 00013 BEGIN CLOSE(DCHAN); DCHAN←-1 END;
␈B↓ε072174↓ε072174␈A007601 00014 TC←TC+1;
␈BβαIF↓ε072426β∧LANDβ∧THEN↓ε016437↓ε015167↓ε072174␈A007611 00015 IF MAPTRC LAND '40000 THEN OUTSTR('11&CVS(TC));
␈BβαIF↓ε071770β∧THEN↓ε015035↓ε071551¬ε070544↓ε015167↓ε072174↓ε105125␈A007627 00016 IF DTRACE THEN OUT(DCHAN,CL&CVS(TC)&'11&S);
␈BββEND∞∧DTRC∞¬DTRCE ε105125↓S␈A007635 00017 END "DTRC";
007635 00018
␈B¬ε071271βπCOMMENT␈A007635 00019 _ line deletion with tracing;
007635 00020
␈BβλINTERNALβεSIMPLEβ PROCEDURE↓ε105112α
¬LINDLβπINTEGER↓ε105214α↓ε105166α␈A007635 00021 INTERNAL SIMPLE PROCEDURE LINDL(INTEGER L,I);
␈Bβ¬BEGIN↓ε072044¬ε071421βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105023¬ε070401↓ε015167↓ε105214↓ε073153↓ε105214↓ε105166ββEND∞¬LINDL ε105214↓L ε105166↓I␈A007657 00022 BEGIN DISW←1; DTRC("LINDEL:"QC(L)); LINDEL(L,I) END;
007657 00023
007657 00024
␈B¬ε071271βπCOMMENT␈A007657 00025 _ Produces trace typeouts, and pauses if correct bit is set in MAPTRC.
007657 00026 Also puts out trace on DSK-file "PARSE.TRC" if bit 12 of MAPTRC is set.;
007657 00027
␈BβλINTERNALβεSIMPLEβ PROCEDURE↓ε105153α
¬QTRCEβεSTRING↓ε105522α␈A007657 00028 INTERNAL SIMPLE PROCEDURE QTRCE(STRING S);
␈Bβ¬BEGIN
∧QTRC␈A007657 00029 BEGIN "QTRC"
␈B¬ε071421βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105023↓ε105522␈A007667 00030 DTRC(S);
␈BβαIF↓ε072426β∧LANDβ∧THEN␈A007672 00031 IF MAPTRC LAND '2000 THEN
␈Bβ¬BEGIN␈A007672 00032 BEGIN
␈B↓ε016437¬ε070544↓ε105522␈A007700 00033 OUTSTR(CL&S);
␈BβαIF↓ε072426β∧LANDβ∧THEN␈A007703 00034 IF MAPTRC LAND '4000 THEN
␈Bβ¬BEGIN␈A007703 00035 BEGIN
␈Bβ¬WHILE↓ε071714↓ε016235↓ε071714βαDO¬ε070455␈A007713 00036 WHILE (ICH←INCHRW)≠":"∧ICH≠"←" DO NOTHING;
␈BβαIF↓ε071714β∧THEN↓ε072426↓ε073270↓ε016315␈A007721 00037 IF ICH="←" THEN MAPTRC←MAPCONV(INSTR(":"))
␈BββEND␈A007722 00038 END
␈BββEND␈A007722 00039 END;
␈BββEND∞∧QTRC∞¬QTRCE ε105522↓S␈A007724 00040 END "QTRC";
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 5-1
MAPS1
␈B¬ε071271βπCOMMENT␈A007724 00041
_ MLCR, REVIVE, UPPDAL;
007724 00002
␈B¬ε071271βπCOMMENT␈A007724 00003 _ Pushes LC onto the LCREDE-stack for line LN.;
007724 00004
␈BβλINTERNALβεSIMPLEβ PROCEDURE↓ε105331α
∧MLCRβπINTEGER↓ε105611α↓ε105700α␈A007724 00005 INTERNAL SIMPLE PROCEDURE MLCR(INTEGER LN,LC);
␈Bβ¬BEGIN
∧MLCR␈A007724 00006 BEGIN "MLCR"
␈B↓ε072044␈A007726 00007 DISW←1;
␈B¬ε071421βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105023¬ε070401↓ε015167↓ε105611¬ε070401↓ε015167↓ε105700␈A007747 00008 DTRC("MLCR: "QC(LN)QC(LC));
␈BβαIF↓ε105611β∧THEN↓ε072543↓ε105611↓ε072543↓ε105611ββLSHββLOR↓ε105700␈A007760 00009 IF LN THEN LCREDE[LN]←LCREDE[LN] LSH 12 LOR LC
␈BββEND∞∧MLCR∞∧MLCR ε105611αLN ε105700αLC␈A007764 00010 END "MLCR";
007764 00011
007764 00012
␈B¬ε071271βπCOMMENT␈A007764 00013 _ Pops LCREDE off top of stack, leaving next-to-newest value.;
007764 00014
␈BβλINTERNALβεSIMPLEβ PROCEDURE↓ε105550α
εREVIVEβπINTEGER↓ε106002α␈A007764 00015 INTERNAL SIMPLE PROCEDURE REVIVE(INTEGER LN);
␈Bβ¬BEGIN
εREVIVE␈A007764 00016 BEGIN "REVIVE"
␈B↓ε072044␈A007766 00017 DISW←1;
␈B¬ε071421βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105023¬ε070401↓ε015167↓ε106002␈A010001 00018 DTRC("REVIVE: "QC(LN));
␈BβαIF↓ε106002β∧THEN↓ε072543↓ε106002↓ε072543↓ε106002ββLSH␈A010010 00019 IF LN THEN LCREDE[LN]←LCREDE[LN] LSH -12
␈BββEND∞εREVIVE∞εREVIVE ε106002αLN␈A010015 00020 END "REVIVE";
010015 00021
␈B¬ε071271βπCOMMENT␈A010015 00022 _ Updates line-display, and waits for a ":" iff SW is on.;
010015 00023
␈BβλINTERNALβεSIMPLEβ PROCEDURE↓ε105726α
εUPPDALβπINTEGER↓ε106071α␈A010015 00024 INTERNAL SIMPLE PROCEDURE UPPDAL(INTEGER SW);
␈Bβ¬BEGIN
εUPPDAL␈A010015 00025 BEGIN "UPPDAL"
␈BβαIF↓ε072044β∧THENβεRETURNβ∧ELSE↓ε072044␈A010023 00026 IF ¬DISW THEN RETURN ELSE DISW←0;
␈BβαIF↓ε106071β∧THEN␈A010025 00027 IF SW>0 THEN
␈Bβ¬BEGIN␈A010025 00028 BEGIN
␈B↓ε072311↓ε072222␈A010027 00029 LNCRE1←LNCRE0;
␈B↓ε072515↓ε072515↓ε072515␈A010041 00030 DICH[4]←DICH[5]←DICH[6]←1;
␈B↓ε073420␈A010042 00031 UPPDAT;
␈BβαIF↓ε072426β∧LANDβ∧THENβ¬BEGIN↓ε104426↓ε104454ββEND␈A010047 00032 IF MAPTRC LAND '100000 THEN BEGIN PRECAL; CALC END;
␈B↓ε016437␈A010052 00033 OUTSTR(" D ");
␈B↓ε072311↓ε071653␈A010052 00034 LNCRE1←LNCS1
␈BββEND␈A010054 00035 END;
␈BβαIF↓ε106071β∧THEN␈A010056 00036 IF SW THEN
␈Bβ¬BEGIN␈A010056 00037 BEGIN
␈Bβ¬WHILE↓ε071714↓ε016235↓ε071714βαDO¬ε070455␈A010066 00038 WHILE (ICH←INCHRW)≠":"∧ICH≠"←" DO NOTHING;
␈BβαIF↓ε071714β∧THEN↓ε072426↓ε073270↓ε016315␈A010074 00039 IF ICH="←" THEN MAPTRC←MAPCONV(INSTR(":"))
␈BββEND␈A010075 00040 END
␈BββEND∞εUPPDAL∞εUPPDAL ε106071αSW␈A010077 00041 END "UPPDAL";
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 6-1
MAPS1
␈B¬ε071271βπCOMMENT␈A010077 00042
_ UNTST, BREAK;
010077 00002
␈B¬ε071271βπCOMMENT␈A010077 00003 _ tests cv for active and inactive lines. Returns zero if all lines
010077 00004 connected to cv are active or inactive. If some lines of each type
010077 00005 are connected, it returns the total number of lines;
010077 00006
␈BβεSIMPLEβπINTEGERβ PROCEDURE↓ε106056α
¬UNTSTβπINTEGER↓ε106247α␈A010077 00007 SIMPLE INTEGER PROCEDURE UNTST(INTEGER CV);
␈Bβ¬BEGIN␈A010077 00008 BEGIN
␈BβπINTEGER↓ε106336α↓ε106351α↓ε106364α↓ε106377α↓ε106412α␈A010077 00009 INTEGER L, FL, FLG, N, RET;
␈B↓ε106351↓ε106336↓ε072617↓ε106247␈A010105 00010 FL ← L ← LVERSI[CV];
␈BβαIF↓ε106351↓ε072762↓ε106351↓ε106336β∧THENβεRETURN␈A010116 00011 IF FL<0∨LVER[FL]=L THEN RETURN(0);
␈B↓ε106364↓ε073624↓ε106351ββDIV␈A010124 00012 FLG ← LACT((FL+1) DIV 2);
␈B↓ε106412␈A010126 00013 RET ← 0;
␈B↓ε106377␈A010130 00014 N ← 1;
␈Bβ¬WHILE↓ε106336↓ε072762↓ε106336↓ε106351βαDO␈A010137 00015 WHILE (L←LVER[L])≠FL DO
␈Bβ¬BEGIN
βUNA␈A010137 00016 BEGIN "UNA"
␈BβαIF↓ε073624↓ε106336ββDIVββXOR↓ε106364β∧THEN↓ε106412␈A010150 00017 IF LACT((L+1) DIV 2) XOR FLG THEN RET←-1;
␈B↓ε106377↓ε106377␈A010153 00018 N ← N+1;
␈BββEND∞βUNA␈A010154 00019 END "UNA";
␈BβεRETURNβαIF↓ε106412β∧THEN↓ε106377β∧ELSE␈A010163 00020 RETURN(IF RET THEN N ELSE 0);
␈BββEND ε106336↓L ε106351αFL ε106364βFLG ε106377↓N ε106412βRET∞¬UNTST ε106247αCV␈A010172 00021 END;
010172 00022
␈B¬ε071271βπCOMMENT␈A010172 00023 _ Breaks cv into two cv's, if necessary, and relinks them to seperate
010172 00024 active and inactive lines. New cv contains all inactive lines;
010172 00025
␈BβεSIMPLEβ PROCEDURE↓ε106160α
¬BREAKβπINTEGER↓ε106377α␈A010172 00026 SIMPLE PROCEDURE BREAK(INTEGER CV);
␈Bβ¬BEGIN␈A010172 00027 BEGIN
␈BβπINTEGER↓ε106336α↓ε106323α↓ε106425α↓ε106310α↓ε106453α↓ε106466α␈A010172 00028 INTEGER LN, L, NCV, I, LAD, N;
␈BβαIF↓ε106466↓ε106056↓ε106377β∧THENβεRETURN␈A010177 00029 IF ¬(N←UNTST(CV)) THEN RETURN;
␈B↓ε106323↓ε072617↓ε106377␈A010204 00030 L ← LVERSI[CV];
␈B↓ε106425␈A010206 00031 NCV ← 0;
␈B↓ε106453␈A010210 00032 LAD ← 1;
␈BβαDOβ¬BEGIN
βBRA␈A010210 00033 DO BEGIN "BRA"
␈B↓ε106336↓ε072762↓ε106323␈A010215 00034 LN ← LVER[L];
␈BβαIF↓ε073624↓ε106323ββDIVβ∧THEN␈A010223 00035 IF ¬LACT((L+1) DIV 2) THEN
␈Bβ¬BEGIN
βBRB␈A010223 00036 BEGIN "BRB"
␈B↓ε104604↓ε106323↓ε106377␈A010230 00037 MSCVCO(-L,CV,0);
␈B↓ε104604↓ε106323↓ε106425↓ε106453␈A010235 00038 MSCVCO(L,-NCV,LAD);
␈B↓ε106453↓ε106453␈A010240 00039 LAD ← LAD+1;
␈BβαIF↓ε106453β∧THEN↓ε106425↓ε072571↓ε106323␈A010247 00040 IF LAD=2 THEN NCV←LVERCO[L];
␈BββEND∞βBRB␈A010247 00041 END "BRB";
␈B↓ε106323↓ε106336␈A010251 00042 L ← LN;
␈B↓ε106466↓ε106466␈A010254 00043 N ← N-1;
␈BββEND∞βBRAβ¬UNTIL↓ε106466␈A010255 00044 END "BRA" UNTIL ¬N;
␈BββEND ε106336αLN ε106323↓L ε106425βNCV ε106310↓I ε106453βLAD ε106466↓N∞¬BREAK ε106377αCV␈A010264 00045 END;
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 7-1
MAPS1
␈B¬ε071271βπCOMMENT␈A010264 00046
_ CLUPSC;
␈B¬ε071271βπCOMMENT␈A010264 00002 _ Cleans up the scene after the isolation of a complete or a best partial,
010264 00003 i.e. removes (to LCREDE=3000+CURMAP) all unused lines coinciding with
010264 00004 or contained within any line of the object. Lines of other objects
010264 00005 linked to common cv's are unlinked and given new cv's;
010264 00006
␈BβλINTERNALβ PROCEDURE↓ε106412α
εCLUPSC␈A010271 00007 INTERNAL PROCEDURE CLUPSC;
␈Bβ¬BEGIN
εCLUPSCβπINTEGER↓ε071510π↓ε106364α↓ε106542α↓ε106570α↓ε106351α↓ε106527α↓ε106603α␈A010271 00008 BEGIN "CLUPSC" INTEGER IA,IB,IC,IV1, LV, M;
␈Bβ∧REAL↓ε106631α↓ε106644α↓ε106657α↓ε106672α↓ε106705α↓ε106720α↓ε106733α␈A010271 00009 REAL RL,X1,X2,DIFX,DIFY,Y1,Y2;
␈B¬ε071475β∧SAFEβπINTEGERβ¬ARRAY↓ε106746α↓ε072276␈A010276 00010 SAFEX INTEGER ARRAY MP[1:MAXNOV];
␈Bεε106774εε107022␈A010276 00011 DEFINE BK(CV)="IF ¬MP[CV] THEN BEGIN BREAK(CV);MP[CV]←1;END",
␈Bεε107007␈A010276 00012 RESET="LNCRE1←LNCS1; LNCRE2←LNCS2";
␈B↓ε106746␈A010301 00013 MP[1] ← 0;
␈B↓ε016051↓ε106746↓ε106746↓ε072276␈A010312 00014 ARRBLT(MP[2],MP[1],MAXNOV-1);
␈B↓ε072146↓ε071564␈A010316 00015 N1←2000+2*CURMAP;
␈B↓ε072467↓ε072467␈A010321 00016 RWIC←2.0*RWIC;
␈B↓ε106603↓ε072146␈A010323 00017 M ← N1-1;
␈B¬ε071317ββFOR↓ε106364β∧STEPβ¬UNTIL↓ε072263βαDOβαIF↓ε106603↓ε104734↓ε106364↓ε072146β∧THEN␈A010335 00018 LOOP(IA,1,MAXNOL,1) IF M≤LCRL(IA)≤N1 THEN
␈Bβ¬BEGIN
βCLA␈A010335 00019 BEGIN "CLA"
␈B↓ε072311↓ε072324↓ε072146␈A010341 00020 LNCRE1←(LNCRE2←N1)-1;
␈B↓ε106542↓ε106364␈A010344 00021 IB←2*IA;
␈B↓ε106644↓ε073010↓ε106351↓ε072571↓ε106542␈A010356 00022 X1←XVCOR[IV1←LVERCO[IB-1]];
␈B↓ε106720↓ε073023↓ε106351␈A010363 00023 Y1←YVCOR[IV1];
␈B¬ε106774βαIF↓ε106746↓ε106351β∧THENβ¬BEGIN↓ε106160↓ε106351↓ε106746↓ε106351ββEND␈A010375 00024 BK(IV1);
␈B↓ε106657↓ε073010↓ε106351↓ε072571↓ε106542␈A010406 00025 X2←XVCOR[IV1←LVERCO[IB]];
␈B↓ε106733↓ε073023↓ε106351␈A010413 00026 Y2←YVCOR[IV1];
␈B¬ε106774βαIF↓ε106746↓ε106351β∧THENβ¬BEGIN↓ε106160↓ε106351↓ε106746↓ε106351ββEND␈A010425 00027 BK(IV1);
␈B↓ε104003↓ε106644↓ε106672↓ε072467↓ε106644↓ε106657↓ε106631↓ε073125↓ε106364␈A010441 00028 REKOP(X1+(DIFX←RWIC*(X1-X2)/(RL←RLEN[IA])),
␈B↓ε106720↓ε106705↓ε072467↓ε106720↓ε106733↓ε106631␈A010450 00029 Y1+(DIFY←RWIC*(Y1-Y2)/RL),
␈B↓ε106657↓ε106672␈A010453 00030 X2-DIFX,
␈B↓ε106733↓ε106705␈A010456 00031 Y2-DIFY,
␈B↓ε072467␈A010457 00032 RWIC,
␈B↓ε106631␈A010461 00033 RL);
␈B¬ε107007↓ε072311↓ε071653↓ε072324↓ε071666␈A010465 00034 RESET;
␈B¬ε071317ββFOR↓ε106542β∧STEPβ¬UNTIL↓ε072263βαDOβαIF↓ε072311↓ε072543↓ε106542β∧LAND␈A010473 00035 LOOP(IB,1,MAXNOL,1) IF LNCRE1≤LCREDE[IB] LAND '400000007777
␈B↓ε072324↓ε073652↓ε106364↓ε106542↓ε072502␈A010504 00036 ≤LNCRE2∧ANGLIN(IA,IB)<RMAP
␈B↓ε073357↓ε073010↓ε106351↓ε072571↓ε106570↓ε106542↓ε073023↓ε106351␈A010526 00037 ∧INREK(XVCOR[IV1←LVERCO[(IC←2*IB)-1]],YVCOR[IV1])
␈B↓ε073357↓ε073010↓ε106351↓ε072571↓ε106570↓ε073023↓ε106351␈A010544 00038 ∧INREK(XVCOR[IV1←LVERCO[IC]],YVCOR[IV1])
␈Bβ∧THENβ¬BEGIN
βCLB␈A010545 00039 THEN BEGIN "CLB"
␈B↓ε105331↓ε106542↓ε072311↓ε072324↓ε071564␈A010554 00040 MLCR(IB,LNCRE1←LNCRE2←3000+CURMAP);
␈B¬ε106774βαIF↓ε106746↓ε106351β∧THENβ¬BEGIN↓ε106160↓ε106351↓ε106746↓ε106351ββEND␈A010566 00041 BK(IV1);
␈B↓ε106351↓ε072571↓ε106570␈A010574 00042 IV1←LVERCO[IC-1];
␈B¬ε106774βαIF↓ε106746↓ε106351β∧THENβ¬BEGIN↓ε106160↓ε106351↓ε106746↓ε106351ββEND␈A010605 00043 BK(IV1);
␈B¬ε107007↓ε072311↓ε071653↓ε072324↓ε071666␈A010611 00044 RESET;
␈BββEND∞βCLB␈A010613 00045 END "CLB";
␈BββEND∞βCLA␈A010615 00046 END "CLA";
␈B↓ε072311↓ε072324↓ε072146␈A010621 00047 LNCRE1←(LNCRE2←N1)-1;
␈B¬ε071317ββFOR↓ε106364β∧STEPβ¬UNTIL↓ε072276βαDOβαIF↓ε106746↓ε106364¬ε071447↓ε104502↓ε106364β∧THEN␈A010634 00048 LOOP(IA,1,MAXNOV,1) IF ¬MP[IA]∧BELCRE(IA) THEN
␈B↓ε104174↓ε106364↓ε073010↓ε106364↓ε073023↓ε106364↓ε106631␈A010651 00049 WEIGHV(IA,XVCOR[IA],YVCOR[IA],RL);
␈B¬ε107007↓ε072311↓ε071653↓ε072324↓ε071666␈A010655 00050 RESET;
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 7-2
CLUPSC
␈B↓ε072467↓ε072467␈A010655 00051 RWIC←RWIC/2.0
␈BββEND∞εCLUPSC ε106364αIA ε106542αIB ε106570αIC ε106351βIV1 ε106527αLV ε106603↓M ε106631αRL ε106644αX1 ε106657αX2 ε106672∧DIFX ε106705∧DIFY ε106720αY1 ε106733αY2 ε106746αMP ε106774αBK ε107007¬RESET∞εCLUPSC␈A010727 00052 END "CLUPSC";
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 8-1
MAPS1
␈B¬ε071271βπCOMMENT␈A010727 00053
_ FUSABL;
010727 00002
␈B¬ε071271βπCOMMENT␈A010727 00003 _ Returns -1 (else 0) iff L2>0 and lines of s.v:s V1 and V2 are collinear.
010727 00004 If L2≤0, we check whether line of s.v. L1 may be extended through V1
010727 00005 (if L2=0) or V2 (if L2=-1).;
010727 00006
␈BβλINTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε106453α
εFUSABLβπINTEGER↓ε107050α↓ε106774α↓ε107035α↓ε106746α␈A010727 00007 INTERNAL SIMPLE INTEGER PROCEDURE FUSABL(INTEGER L1,L2,V1,V2);
␈Bβ¬BEGIN
εFUSABL␈A010727 00008 BEGIN "FUSABL"
␈BβπINTEGER↓ε106705α␈A010727 00009 INTEGER IL1;
␈B↓ε106705↓ε107050␈A010733 00010 IL1←(L1+1)%2;
␈B¬ε071421βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105023¬ε070401↓ε015167↓ε107050¬ε070401↓ε015167↓ε106774¬ε070401↓ε015167↓ε107035¬ε070401↓ε015167↓ε106746␈A010770 00011 DTRC("FUSABL: "QC(L1)QC(L2)QC(V1)QC(V2));
␈BβαIF↓ε106774ββABS↓ε072604↓ε107035↓ε106746ββABS↓ε072604↓ε106746↓ε107035β∧THENβεRETURN␈A011010 00012 IF L2>0∧(ABS LINK[V1]=V2 ∨ ABS LINK[V2]=V1) THEN RETURN(-1);
␈BβαIF↓ε106774β∧THEN␈A011012 00013 IF L2≤0 THEN
␈BβεRETURNββABS↓ε073064↓ε106705␈A011015 00014 RETURN(ABS(CXL[IL1]
␈B↓ε073010↓ε072146β∧CASE↓ε106774βαOF↓ε107035↓ε106746␈A011035 00015 *XVCOR[N1←CASE -L2 OF(V1,V2)]
␈B↓ε073077↓ε106705␈A011042 00016 +CYL[IL1]
␈B↓ε073023↓ε072146␈A011045 00017 *YVCOR[N1]
␈B↓ε073112↓ε106705␈A011054 00018 +CCL[IL1])
␈B↓ε072467␈A011055 00019 ≤RWIC
␈B↓ε073767↓ε073010↓ε072146↓ε073036↓ε107050↓ε073023↓ε072146↓ε073051↓ε107050␈A011101 00020 *SQRT((XVCOR[N1]-XLCOR[L1])↑2+(YVCOR[N1]-YLCOR[L1])↑2)
␈B↓ε073125↓ε106705␈A011114 00021 /RLEN[IL1]);
␈BβεRETURN↓ε103727↓ε073036↓ε107035␈A011117 00022 RETURN(KARN(XLCOR[V1]
␈B↓ε073051↓ε107035␈A011123 00023 ,YLCOR[V1]
␈B↓ε073036↓ε106705↓ε073713↓ε107035␈A011132 00024 ,XLCOR[IL1←LVOPP(V1)]
␈B↓ε073051↓ε106705␈A011136 00025 ,YLCOR[IL1]
␈B↓ε073036↓ε106746␈A011141 00026 ,XLCOR[V2]
␈B↓ε073051↓ε106746␈A011144 00027 ,YLCOR[V2]
␈B↓ε073036↓ε106705↓ε073713↓ε106746␈A011153 00028 ,XLCOR[IL1←LVOPP(V2)]
␈B↓ε073051↓ε106705␈A011170 00029 ,YLCOR[IL1],-1)=1)
␈BββEND∞εFUSABL ε106705βIL1∞εFUSABL ε107050αL1 ε106774αL2 ε107035αV1 ε106746αV2␈A011174 00030 END "FUSABL";
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 9-1
MAPS1
␈B¬ε071271βπCOMMENT␈A011174 00031
_ LFDIF;
011174 00002
␈B¬ε071271βπCOMMENT␈A011174 00003 _ Returns encoded actions to be performed at end ND2 of LF2 in order to
011174 00004 make it similar to end ND1 of LF1. Other ends must agree (otherwise
011174 00005 error-return = '400). The program also sets the sequential modification
011174 00006 word (MODIF). MODIF contains two bits for each line-position at ND2 of
011174 00007 LF2, telling what to do at that position:
011174 00008 {(0 = no change)(1 = insert line here)(2 = delete line here)
011174 00009 (3 unused code)}.
011174 00010 MODIF←-1 if there is no unambiguous modification possible.
011174 00011 MODIF has its high bit turned on iff end single before insertions.
011174 00012 The program pays no attention to the outer angle at ND2 of LF2.;
011174 00013
␈BβλINTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε107007α
¬LFDIFβπINTEGER↓ε106733α↓ε106657α↓ε106542α↓ε106570α␈A011174 00014 INTERNAL SIMPLE INTEGER PROCEDURE LFDIF(INTEGER LF1,LF2,ND1,ND2);
␈Bβ¬BEGIN
¬LFDIF␈A011174 00015 BEGIN "LFDIF"
␈BβπINTEGER↓ε107111α↓ε107302α↓ε072146π↓ε107076α↓ε072161π↓ε107124α↓ε107226α↓ε107200α↓ε071510π↓ε107254α↓ε107152α↓ε107315α↓ε107267α↓ε107330α↓ε107343α↓ε107356α↓ε107371α↓ε107404α␈A011174 00016 INTEGER C1,C2,N1,N2,NLDIF,PAR,IA,IB,DEL,CH,IRET,INS,D1,D2,IPD,
␈B↓ε107417α↓ε107432α↓ε107445α↓ε107460α↓ε107473α↓ε107506α↓ε107521α↓ε107534α␈A011174 00017 DS1,DS2,CHAR,POS1,POS2,INSTOT,NTOT,BARAM;
011174 00018
␈B¬ε071271βπCOMMENT␈A011174 00019 _ DN is displacement for other ends. DSN originally points to
011174 00020 "#lines>180", later to "#lines≤180". CN = constellation bits.
011174 00021 CH=INS∨DEL all refer to first or last line respectively.;
011174 00022
␈Bβ¬LABEL↓ε107547α␈A011174 00023 LABEL OU;
␈B↓ε107417↓ε107356↓ε106542␈A011201 00024 DS1←31-(D1←18*ND1);
␈B↓ε107432↓ε107371↓ε106570␈A011206 00025 DS2←31-(D2←18*ND2);
␈B↓ε072031↓ε107330↓ε107506↓ε107521↓ε107534␈A011214 00026 MDCTR←IRET←INSTOT←NTOT←BARAM←0;
␈B↓ε072352␈A011216 00027 MODIF←2;
␈B↓ε071701↓ε073214↓ε106733↓ε107417↓ε107417␈A011225 00028 RAYS←BITS(LF1,DS1,DS1+3);
␈BβαIF↓ε106733ββLSH↓ε107356ββXOR↓ε106657ββLSH↓ε107371β∧LANDβ∧THEN␈A011236 00029 IF ((LF1 LSH (-D1)) XOR (LF2 LSH (-D2))) LAND '367500 THEN
␈Bβ¬BEGIN↓ε072352↓ε107330βαGO↓ε107547ββEND␈A011243 00030 BEGIN MODIF←-1; IRET←'400; GO OU END;
011243 00031
␈B¬ε071271βπCOMMENT␈A011243 00032 _ The other ends are in agreement.;
011243 00033
␈B¬ε071317ββFOR↓ε107254β∧STEPβ¬UNTILβαDO␈A011247 00034 LOOP(IA,1,2,1)
␈Bβ¬BEGIN␈A011247 00035 BEGIN
␈B↓ε107111↓ε073214↓ε106733↓ε107356↓ε107356␈A011260 00036 C1←BITS(LF1,3+D1,4+D1);
␈B↓ε107302↓ε073214↓ε106657↓ε107371↓ε107371␈A011271 00037 C2←BITS(LF2,3+D2,4+D2);
␈B↓ε107343↓ε107302↓ε107111β∧LAND↓ε107302↓ε107111␈A011305 00038 INS←(C2=2∧(C1 LAND 1)∨C2∧¬C1);
␈B↓ε107267↓ε107315↓ε107111↓ε107302↓ε107111↓ε107302β∧LAND↓ε107343␈A011330 00039 CH←-((DEL←C1∧¬C2∨C1=2∧(C2 LAND 1))∨INS);
␈B↓ε107200↓ε107111β∧LAND␈A011333 00040 PAR←C1 LAND 1;
␈B↓ε107404↓ε107343↓ε107200↓ε107315␈A011344 00041 IPD←INS∨PAR∧¬DEL;
␈B↓ε107330↓ε107330ββLSHββLOR↓ε107267ββLSHββLOR↓ε107315ββLSHββLOR↓ε107200␈A011355 00042 IRET←((IRET LSH 1 LOR CH) LSH 1 LOR (-DEL)) LSH 1 LOR PAR;
␈B↓ε107226↓ε107076↓ε073214↓ε106733↓ε107417↓ε107417␈A011364 00043 NLDIF←(N1←BITS(LF1,DS1,DS1+3))-
␈B↓ε107124↓ε073214↓ε106657↓ε107432↓ε107432↓ε107343↓ε107315␈A011400 00044 (N2←BITS(LF2,DS2,DS2+3))+INS-DEL;
␈B↓ε107330↓ε107330ββLSHββLOR↓ε107226␈A011410 00045 IRET←( ( ( (IRET LSH 1 LOR(-(NLDIF<0)))
␈BββLSHββLORββABS↓ε107226␈A011413 00046 LSH 4 LOR ABS NLDIF)
␈BββLSHββLOR↓ε107460βαIF↓ε107254β∧THENβ∧ELSE␈A011422 00047 LSH 4 LOR (POS1←IF IA=2 THEN 1 ELSE
␈BβαIF↓ε107404β∧THENβ∧ELSE␈A011432 00048 IF IPD THEN 2 ELSE 1))
␈BββLSHββLOR↓ε107473βαIF↓ε107226β∧THEN↓ε107076β∧ELSE↓ε107124↓ε107343↓ε107315␈A011444 00049 LSH 4 LOR (POS2←(IF NLDIF≥0 THEN N1 ELSE N2-INS+DEL)
␈B↓ε107254↓ε107404␈A011457 00050 +(IA=2∧IPD)))
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 9-2
LFDIF
␈BββLSHββLOR↓ε107445βαIF↓ε107267↓ε107226β∧THEN↓ε107076β∧ELSE␈A011473 00051 LSH 2 LOR (CHAR←IF ¬CH∧¬NLDIF THEN -(N1>0) ELSE
␈BβαIF↓ε107226β∧THENβ∧ELSE␈A011477 00052 IF ¬NLDIF THEN 2 ELSE
␈BβαIFββABS↓ε107226↓ε107473↓ε107460β∧THENβ∧ELSE␈A011507 00053 IF ABS NLDIF=POS2-POS1+1 THEN 2 ELSE
␈B↓ε107534␈A011520 00054 (BARAM←2)+1);
␈BβαIF↓ε107445β∧THEN↓ε072352↓ε072352ββLSH↓ε107076β∧ELSE␈A011532 00055 IF CHAR<2 THEN MODIF←MODIF LSH (2*N1) ELSE
␈Bβ¬BEGIN␈A011532 00056 BEGIN
␈BβαIF↓ε107254↓ε107267↓ε107200β∧THEN␈A011541 00057 IF IA=1∧(CH∨PAR) THEN
␈B↓ε072352↓ε072352ββLSHββLOR↓ε107343↓ε107315␈A011551 00058 MODIF←MODIF LSH 2 LOR (-INS-2*DEL);
␈B↓ε107124βαIF↓ε107226β∧THEN↓ε107124↓ε107315↓ε107200↓ε107343β∧ELSE↓ε107076↓ε107404␈A011571 00059 N2←IF NLDIF<0 THEN N2+(DEL∨PAR∧¬INS) ELSE N1+IPD;
␈B¬ε071317ββFOR↓ε107152β∧STEPβ¬UNTIL↓ε107124βαDO␈A011575 00060 LOOP(IB,1,N2,1)
␈B↓ε072352↓ε072352ββLSHββLOR␈A011577 00061 MODIF←MODIF LSH 2 LOR
␈BβαIF↓ε107445β∧THENβ∧ELSE␈A011605 00062 (IF CHAR=3 THEN 3 ELSE
␈BβαIF↓ε107226β∧THENβ∧ELSE␈A011611 00063 IF NLDIF>0 THEN 1 ELSE
␈BβαIF↓ε107226β∧THENβ∧ELSE␈A011624 00064 IF ¬NLDIF THEN 0 ELSE 2);
␈BβαIF↓ε107254↓ε107267↓ε107200β∧THEN␈A011633 00065 IF IA=2∧(CH∨PAR) THEN
␈B↓ε072352↓ε072352ββLSHββLOR↓ε107343↓ε107315␈A011641 00066 MODIF←MODIF LSH 2 LOR (-INS-2*DEL)
␈BββEND␈A011643 00067 END;
␈B↓ε107356↓ε107356␈A011646 00068 D1←18-D1;
␈B↓ε107371↓ε107371␈A011651 00069 D2←18-D2;
␈B↓ε107417↓ε107417␈A011654 00070 DS1←DS1-5;
␈B↓ε107432↓ε107432␈A011657 00071 DS2←DS2-5;
␈B↓ε107506↓ε107506↓ε107343ββMAX↓ε107226␈A011666 00072 INSTOT←INSTOT-INS+(0 MAX NLDIF);
␈B↓ε107521↓ε107521↓ε107076␈A011666 00073 NTOT←NTOT+N1
␈BββEND␈A011673 00074 END;
␈Bβ
START.CODEβ¬LABEL↓ε107725α↓ε107651α␈A011673 00075 START_CODE LABEL L1, L2;
␈B↓ε072352␈A011674 00076 SKIPG 1,MODIF;
␈B↓ε107651␈A011675 00077 JRST L2;
␈B↓ε072031␈A011676 00078 MOVE 2,MDCTR;
␈B↓ε107725ββLSH␈A011677 00079 L1: LSH 1,2;
011700 00080 ADDI 2,2;
␈B↓ε107725␈A011701 00081 JUMPG 1,L1;
␈B↓ε072031␈A011702 00082 MOVEM 2,MDCTR;
␈B↓ε072352␈A011703 00083 MOVEM 1,MODIF;
␈B↓ε107651ββEND␈A011703 00084 L2: END;
011703 00085
␈B↓ε072352↓ε072352β∧LANDββLOR↓ε107534↓ε107506↓ε107521ββLSH␈A011720 00086 MODIF←(MODIF LAND '177777777777) LOR ((BARAM-(INSTOT=NTOT)) LSH 34);
␈B↓ε107547¬ε071421βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105023¬ε070414↓ε015322↓ε106733¬ε070414↓ε015322↓ε106657¬ε070401↓ε015167↓ε106542¬ε070401↓ε015167↓ε106570¬ε070414↓ε015322↓ε107330¬ε070414↓ε015322↓ε072352␈A011771 00087 OU: DTRC("LFDIF: "QCO(LF1)QCO(LF2)QC(ND1)QC(ND2)QCO(IRET)QCO(MODIF));
␈BβεRETURN↓ε107330␈A011773 00088 RETURN(IRET)
␈BββEND∞¬LFDIF ε107111αC1 ε107302αC2 ε107076αN1 ε107124αN2 ε107226¬NLDIF ε107200βPAR ε107254αIA ε107152αIB ε107315βDEL ε107267αCH ε107330∧IRET ε107343βINS ε107356αD1 ε107371αD2 ε107404βIPD ε107417βDS1 ε107432βDS2 ε107445∧CHAR ε107460∧POS1 ε107473∧POS2 ε107506εINSTOT ε107521∧NTOT ε107534¬BARAM ε107547αOU ε107725αL1 ε107651αL2∞¬LFDIF ε106733βLF1 ε106657βLF2 ε106542βND1 ε106570βND2␈A012026 00089 END "LFDIF";
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 10-1
MAPS1
␈B¬ε071271βπCOMMENT␈A012026 00090
_ MAP (VCRKEY);
012026 00002
␈B¬ε071271βπCOMMENT␈A012026 00003 _ Sets up the expanded parallel datastructure for prototype PROT.
012026 00004 Then initializes mapping arrays according to the basic mapping
012026 00005 provided by the key feature FEAT (c.f. or l.f.) from the scene
012026 00006 into the prototype. Then calls MAPREC to complete the mapping,
012026 00007 described in PLMAP (scene-line corresponding to prot.-line)
012026 00008 and in PVMAP (scene-vertex corresponding to prot.-vertex).;
012026 00009
␈BβλINTERNALβπINTEGERβ PROCEDURE↓ε106705α
βMAPβπINTEGER↓ε107547α↓ε107534α↓ε107521α␈A012033 00010 INTERNAL INTEGER PROCEDURE MAP(INTEGER LSC,LPR,DIR);
␈Bβ¬BEGIN
βMAP␈A012033 00011 BEGIN "MAP"
␈BβπINTEGER↓ε071510π↓ε107445α↓ε107432α↓ε107417α↓ε107404α␈A012033 00012 INTEGER IA,PLNE,SHFT,IB;
␈Bβ∧SAFEβλINTERNALβπINTEGERβ¬ARRAY↓ε107371α↓ε107356α↓ε107343α↓ε107330α↓ε107267α↓ε071612␈A012056 00013 SAFE INTERNAL INTEGER ARRAY LENDV,LENDP,LLEV,LLEVO,PLMAPO[1:PLIN,0:1],
␈B↓ε107124α↓ε107076α↓ε107302α↓ε107111α↓ε106323α↓ε071612↓ε110116α↓ε071625␈A012104 00014 MAPORD,PARCLA,LENCAT,INSLEV,LFTSTL[1:PLIN],VLEV[1:PVER];
␈Bβ∧SAFEβλEXTERNALβπINTEGERβ¬ARRAY↓ε111055α↓ε111070α↓ε111103α␈A012104 00015 SAFE EXTERNAL INTEGER ARRAY PLMAP[1:1,0:1],FLMAPS,PVMAP[1:1],
␈B↓ε111116α␈A012104 00016 PARTS[0:1,1:63];
012104 00017
␈B¬ε071271βπCOMMENT␈A012104 00018 _ Returns 1 (else 0) iff present key is unexplored (virgin).;
012104 00019
␈BβεSIMPLEβπINTEGERβ PROCEDURE↓ε111144α↓ε111157α
εVIRKEY␈A012105 00020 SIMPLE INTEGER PROCEDURE VIRKEY;
␈Bβ¬BEGIN
εVIRKEY␈A012105 00021 BEGIN "VIRKEY"
␈BβπINTEGER↓ε107445π↓ε111261α↓ε107404π↓ε111274α␈A012105 00022 INTEGER IA,IB;
␈B↓ε111274↓ε107547ββLSHββLOR↓ε071577ββLSHββLOR↓ε107534ββLSHββLOR↓ε107521␈A012115 00023 IB←((LSC LSH 12 LOR PROT) LSH 12 LOR LPR) LSH 1 LOR DIR;
␈BβαIF↓ε072072β∧THEN¬ε071317ββFOR↓ε111261β∧STEPβ¬UNTIL↓ε072057βαDO␈A012123 00024 IF FTSW THEN LOOP(IA,1,FLMIND,1)
␈BβαIF↓ε111070↓ε111261↓ε111274β∧THENβεRETURNβ∧ELSE␈A012133 00025 IF FLMAPS[IA]=IB THEN RETURN(0) ELSE
␈Bβ∧ELSE↓ε111070↓ε072057↓ε072057↓ε111274␈A012145 00026 ELSE FLMAPS[FLMIND←FLMIND+1]←IB;
␈BβεRETURN␈A012147 00027 RETURN(1)
␈BββEND∞εVIRKEY ε111261αIA ε111274αIB∞εVIRKEY␈A012152 00028 END "VIRKEY";
012152 00029
␈B¬ε071345βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105153¬ε070544↓ε015167↓ε071577↓ε015167↓ε107534↓ε015167↓ε107547␈A012200 00030 QTRC(CL&"PROT= "&CVS(PROT)&" LPR= "&CVS(LPR)&" LSC= "&CVS(LSC)&
␈B↓ε015322↓ε107521¬ε070544␈A012213 00031 " DIR= "&CVOS(DIR)&CL);
␈B↓ε072105↓ε107521ββLSHβ∧LANDββXOR↓ε107521↓ε107521β∧LAND␈A012223 00032 LFDBT←(DIR LSH -1) LAND 1 XOR (DIR←DIR LAND 1);
␈BβαIF↓ε073624↓ε107547↓ε111157β∧THEN␈A012230 00033 IF ¬LACT(LSC)∨¬VIRKEY THEN
␈Bβ¬BEGIN␈A012230 00034 BEGIN
␈B¬ε071345βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105153¬ε070544¬ε070544␈A012240 00035 QTRC(CL&"Key not virgin"&CL);
␈BβεRETURN␈A012244 00036 RETURN(-1)
␈BββEND␈A012244 00037 END;
␈BβαIF↓ε072426β∧LANDβ∧THEN␈A012247 00038 IF MAPTRC LAND '20000 THEN
␈Bβ¬BEGIN␈A012247 00039 BEGIN
␈B↓ε016437␈A012252 00040 OUTSTR("NEW KEY - MAPTRC? ");
␈BβαIF↓ε016235β∧THEN↓ε072426↓ε073270↓ε016315␈A012261 00041 IF INCHRW="←" THEN MAPTRC←MAPCONV(INSTR(":"));
␈B↓ε016437¬ε070544␈A012264 00042 OUTSTR(CL)
␈BββEND␈A012264 00043 END;
012264 00044
␈B¬ε071271βπCOMMENT␈A012264 00045 _ First set up expanded prototype datastructure,
012264 00046 and zero line-mapping arrays.;
012264 00047
␈B¬ε071317ββFOR↓ε107445β∧STEPβ¬UNTIL↓ε071612βαDO␈A012270 00048 LOOP(IA,1,PLIN,1)
␈Bβ¬BEGIN␈A012270 00049 BEGIN
␈B↓ε107076↓ε107445↓ε107432↓ε072673↓ε071640↓ε107445β∧LAND␈A012301 00050 PARCLA[IA]←(PLNE←PLINE[AD0+IA]) LAND '37;
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 10-2
MAP
␈B↓ε107302↓ε107445↓ε072706↓ε071640↓ε107445ββLSHβ∧LAND␈A012313 00051 LENCAT[IA]←PLINE2[AD0+IA] LSH -9 LAND 1;
␈B¬ε071317ββFOR↓ε107404β∧STEPβ¬UNTILβαDO␈A012317 00052 LOOP(IB,0,1,1)
␈Bβ¬BEGIN␈A012317 00053 BEGIN
␈B↓ε111055↓ε107445↓ε107404↓ε107343↓ε107445↓ε107404␈A012334 00054 PLMAP[IA,IB]←LLEV[IA,IB]←0;
␈B↓ε107371↓ε107445↓ε107404↓ε073214↓ε107432↓ε107417↓ε107404↓ε107417␈A012355 00055 LENDV[IA,IB]←BITS(PLNE,30-(SHFT←6*IB),35-SHFT);
␈B↓ε107356↓ε107445↓ε107404↓ε073214↓ε107432↓ε107417↓ε107417␈A012372 00056 LENDP[IA,IB]←BITS(PLNE,18-SHFT,23-SHFT)
␈BββEND␈A012374 00057 END
␈BββEND␈A012400 00058 END;
␈B¬ε071317ββFOR↓ε107445β∧STEPβ¬UNTIL↓ε071625βαDO↓ε111103↓ε107445↓ε110116↓ε107445␈A012416 00059 LOOP(IA,1,PVER,1) PVMAP[IA]←VLEV[IA]←0;
012416 00060
␈B¬ε071271βπCOMMENT␈A012416 00061 _ Initialize the mapping (1 line) and call on MAPREC to do the job.;
012416 00062
␈B↓ε107124↓ε107534␈A012421 00063 MAPORD[1]←LPR;
␈B↓ε105331↓ε107547␈A012424 00064 MLCR(LSC,1001);
␈B↓ε111055↓ε107534↓ε072105↓ε107547↓ε107521ββXOR↓ε072105␈A012441 00065 PLMAP[LPR,1-LFDBT]←2*LSC-(DIR XOR LFDBT);
␈B↓ε107343↓ε107534↓ε072105␈A012451 00066 LLEV[LPR,1-LFDBT]←1;
␈B↓ε111116↓ε071727↓ε071577↓ε072003␈A012461 00067 PARTS[CMPIND,0]←PROT; KMP←1;
␈BβεRETURN↓ε104324␈A012465 00068 RETURN(MAPREC)
␈BββEND∞βMAP ε107445αIA ε107432∧PLNE ε107417∧SHFT ε107404αIB ε107371¬LENDV ε107356¬LENDP ε107343∧LLEV ε107330¬LLEVO ε107267εPLMAPO ε107124εMAPORD ε107076εPARCLA ε107302εLENCAT ε107111εINSLEV ε106323εLFTSTL ε110116∧VLEV ε111055¬PLMAP ε111070εFLMAPS ε111103¬PVMAP ε111116¬PARTS ε111144εKLST.. ε111157εVIRKEY∞βMAP ε107547βLSC ε107534βLPR ε107521βDIR␈A012550 00069 END "MAP";
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 11-1
MAPS1
␈B¬ε071271βπCOMMENT␈A012550 00070
_ PARSE;
012550 00002
012550 00003
␈B¬ε071271βπCOMMENT␈A012550 00004 _ Will attempt to find a satisfactory parsing of the scene. Note that the
012550 00005 PARTS-storage implementation limits the number of lines to 511.;
012550 00006
␈BβλINTERNALβ PROCEDURE↓ε107725α
¬PARSE␈A012555 00007 INTERNAL PROCEDURE PARSE;
␈Bβ¬BEGIN
¬PARSE␈A012555 00008 BEGIN "PARSE"
␈Bβ¬LABEL↓ε111055α↓ε110116α↓ε107766α↓ε106323α↓ε107677α␈A012555 00009 LABEL ITER,REP,REV,ISO,BA1;
␈Bβ∧SAFEβλINTERNALβπINTEGERβ¬ARRAY↓ε107111α↓ε072400↓ε107302α↓ε072413␈A012571 00010 SAFE INTERNAL INTEGER ARRAY PLMAP[1:MAXPLS,0:1],PVMAP[1:MAXPVS],
␈B↓ε107076α↓ε072400↓ε107124α↓ε072276␈A012610 00011 PARTS[1:63,0:1+MAXPLS%3],FLMAPS[1:MAXNOV];
␈BβπINTEGER↓ε107267α↓ε071510π↓ε107315α↓ε107330α↓ε107152α↓ε107343α↓ε107254α↓ε107356α↓ε107200α↓ε107371α↓ε107226α↓ε107404α␈A012610 00012 INTEGER MAXCOM,IA,IB,KADR,PFP,CFP,PRP,SCL1,SCL2,PRL1,PRL2,
␈B↓ε107417α↓ε107432α↓ε107445α↓ε107473α↓ε111465α↓ε111513α↓ε111376α␈A012610 00013 LB,UB,FTI,UBI,DIR,IBB,ICC,
␈B↓ε111424α↓ε111526α↓ε111541α↓ε111554α↓ε111567α↓ε111602α↓ε111615α↓ε111630α↓ε111643α↓ε111656α␈A012610 00014 ORD,SUCC,IC,ID,MXMXCM,I1,I2,I3,REVER,PARTSI;
012610 00015
012610 00016
␈B¬ε071271βπCOMMENT␈A012610 00017 _ Returns s.v.-entry in PARTS, corresponding
012610 00018 to prototype line L of mapping M.;
012610 00019
␈BβλINTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε111671α↓ε111704α
εLPARTSβπINTEGER↓ε111745α↓ε111760α␈A012611 00020 INTERNAL SIMPLE INTEGER PROCEDURE LPARTS(INTEGER M,L);
␈BβεRETURN↓ε073214↓ε107076↓ε111745↓ε111513↓ε111760↓ε111376↓ε111513↓ε111760↓ε111376∞εLPARTS ε111745↓M ε111760↓L␈A012636 00021 RETURN(BITS(PARTS[M,IBB←(L+2)%3],ICC←12*(3*IBB-L),ICC+11));
012636 00022
␈B¬ε071271βπCOMMENT␈A012636 00023 _ Returns line indicated in LPARTS(M,L), 0 iff no line specified.;
012636 00024
␈BβλINTERNALβεSIMPLEβπINTEGERβ PROCEDURE↓ε111732α
εLPARTLβπINTEGER↓ε112034α↓ε112047α␈A012636 00025 INTERNAL SIMPLE INTEGER PROCEDURE LPARTL(INTEGER M,L);
␈BβεRETURNβαIF↓ε111513↓ε111704↓ε112034↓ε112047β∧LANDβ∧THEN↓ε111513␈A012645 00026 RETURN(((IF (IBB←LPARTS(M,L) LAND '1777)≠'1777 THEN IBB
␈Bβ∧ELSE∞εLPARTL ε112034↓M ε112047↓L␈A012656 00027 ELSE 0)+1)%2);
012656 00028
␈B↓ε072222↓ε071653↓ε072311␈A012661 00029 LNCRE0←LNCS1←LNCRE1;
␈B↓ε071666↓ε072324␈A012663 00030 LNCS2←LNCRE2;
␈BβαIF↓ε072426β∧THEN␈A012666 00031 IF MAPTRC=-1 THEN
␈Bβ¬BEGIN␈A012666 00032 BEGIN
␈B↓ε072426␈A012670 00033 MAPTRC←0;
␈B¬ε071317ββFOR↓ε107315β∧STEPβ¬UNTIL↓ε072263βαDO␈A012674 00034 LOOP(IA,1,MAXNOL,1)
␈Bβ¬BEGIN␈A012674 00035 BEGIN
␈Bβ¬WHILE↓ε107330↓ε104734↓ε107315βαDO↓ε105550↓ε107315␈A012704 00036 WHILE (IB←LCRL(IA))>2000 DO REVIVE(IA);
␈BβαIF↓ε107330β∧THEN↓ε105550↓ε107315β∧ELSE␈A012712 00037 IF IB=1001 THEN REVIVE(IA) ELSE
␈BβαIF↓ε107330↓ε107330β∧THEN↓ε105112↓ε107315␈A012723 00038 IF IB≥1002∧IB≤1005 THEN LINDL(IA,0)
␈BββEND␈A012725 00039 END;
␈B↓ε073563␈A012726 00040 UNXREF;
␈B↓ε105726␈A012730 00041 UPPDAL(0);
␈BβεRETURN␈A012730 00042 RETURN
␈BββEND␈A012733 00043 END;
␈B↓ε071770↓ε072426β∧LAND␈A012736 00044 DTRACE←MAPTRC LAND '10000;
␈B↓ε071551↓ε072133␈A012741 00045 DCHAN←NPRS←-1;
␈B¬ε071345βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105153¬ε070544¬ε070544␈A012750 00046 QTRC(CL&"PARSER RESULTS:"&CL);
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 12-1
PARSE
␈B¬ε071271βπCOMMENT␈A012750 00047
_ PARSE cont;
012750 00002
␈B¬ε071271βπCOMMENT␈A012750 00003 _ Initialize PFPTR.;
012750 00004
␈B↓ε072174↓ε072207↓ε071564␈A012754 00005 TC←TCS←CURMAP←0;
␈B↓ε111656↓ε072400␈A012760 00006 PARTSI←1+MAXPLS%3;
␈B↓ε110116↓ε107417↓ε072365␈A012763 00007 REP: LB←PLFTOT+1;
␈B↓ε107432↓ε072337␈A012765 00008 UB←PFTOT;
␈B↓ε107473␈A012767 00009 UBI←1;
␈B↓ε072072↓ε072057␈A012772 00010 FTSW←FLMIND←0;
␈B¬ε071345βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105153¬ε070544␈A013002 00011 QTRC("CF-keys"&CL);
␈B↓ε073522␈A013004 00012 XREFC(0);
␈B↓ε073474␈A013005 00013 FTEX;
013005 00014
␈B¬ε071271βπCOMMENT␈A013005 00015 _ Display scene?;
013005 00016
␈BβαIF↓ε072426β∧LANDβ∧THEN␈A013010 00017 IF MAPTRC LAND '1000000 THEN
␈Bβ¬BEGIN␈A013010 00018 BEGIN
␈B↓ε016437¬ε070544␈A013013 00019 OUTSTR(CL&"SCENE");
␈B↓ε105726↓ε072426β∧LAND␈A013017 00020 UPPDAL(MAPTRC LAND '2000000)
␈BββEND␈A013017 00021 END;
␈B¬ε071317ββFOR↓ε107315β∧STEPβ¬UNTIL↓ε072337βαDO↓ε072734↓ε107315↓ε072734↓ε107315β∧LAND␈A013034 00022 LOOP(IA,1,PFTOT,1) PFPTR[IA]←PFPTR[IA] LAND '377777777777;
013034 00023
␈B¬ε071271βπCOMMENT␈A013034 00024 _ Find un-exhausted key of maximum complexity.;
013034 00025
␈B↓ε111567↓ε072120␈A013037 00026 MXMXCM←BESTMP←0;
␈B↓ε071727↓ε071564↓ε071564␈A013044 00027 CMPIND←(CURMAP←CURMAP+1)+1;
␈B↓ε107076↓ε071727␈A013052 00028 PARTS[CMPIND,0]←1;
␈B¬ε071317ββFOR↓ε107315β∧STEPβ¬UNTIL↓ε072276βαDO↓ε107124↓ε107315␈A013063 00029 LOOP(IA,1,MAXNOV,1) FLMAPS[IA]←0;
␈B↓ε111055↓ε107267↓ε072003↓ε111526␈A013067 00030 ITER: MAXCOM←KMP←SUCC←0;
␈B¬ε071317ββFOR↓ε107315↓ε107432β∧STEPβ¬UNTIL↓ε107417βαDOβαIF↓ε107267↓ε072734↓ε107315β∧THEN␈A013100 00031 LOOP(IA,UB,LB,-1) IF MAXCOM<PFPTR[IA] THEN
␈BβαIF↓ε107267↓ε072734↓ε107152↓ε107315↓ε111567β∧THENβ∧DONE␈A013114 00032 IF(MAXCOM←PFPTR[KADR←IA])=MXMXCM THEN DONE;
␈BβαIF↓ε107267β∧THENβαGO↓ε106323␈A013117 00033 IF ¬MAXCOM THEN GO ISO;
␈B↓ε111567↓ε107267␈A013121 00034 MXMXCM←MAXCOM;
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 13-1
PARSE
␈B¬ε071271βπCOMMENT␈A013121 00035
_ PARSE cont;
013121 00002
␈B¬ε071271βπCOMMENT␈A013121 00003 _ Now exhaust the mappings where this feature serves as the key.;
013121 00004
␈B↓ε107254↓ε073214↓ε111541↓ε072734↓ε107152␈A013133 00005 CFP←BITS(IC←PFPTR[KADR],12,23);
␈B↓ε111424↓ε111541β∧LAND␈A013136 00006 ORD←IC LAND '4000000000;
␈B¬ε071421βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105023¬ε070401↓ε015167↓ε107152¬ε070401↓ε015167↓ε107254¬ε070401↓ε015167↓ε111424␈A013165 00007 DTRC(" "QC(KADR)QC(CFP)QC(ORD));
␈B¬ε071317ββFOR↓ε107445β∧STEPβ¬UNTIL↓ε107473βαDOβαIF↓ε072072↓ε072311↓ε072543↓ε107445β∧LAND␈A013176 00008 LOOP(FTI,1,UBI,1) IF ¬FTSW∨LNCRE1≤LCREDE[FTI] LAND '400000007777
␈B↓ε072324↓ε107330↓ε072556↓ε107445␈A013212 00009 ≤LNCRE2∧((IB←LFEAT[FTI])<0∧
␈B↓ε072072↓ε107330↓ε072072↓ε107152↓ε107330β∧LANDβ∧THEN␈A013226 00010 FTSW=2∨IB>0∧FTSW=1)∧KADR=IB LAND '7777 THEN
␈Bβ¬WHILE↓ε107254↓ε107254↓ε072072βαDO␈A013232 00011 WHILE (CFP←CFP+FTSW) DO
␈Bβ¬BEGIN
∧CFPL␈A013232 00012 BEGIN "CFPL"
␈B↓ε107200βαIF↓ε072072β∧THEN↓ε107445β∧ELSE↓ε073214↓ε111541↓ε072775↓ε107254␈A013251 00013 SCL1←IF FTSW THEN FTI ELSE BITS(IC←CFEAT[CFP],24,34);
␈BβαIF↓ε072072β∧THEN↓ε107371↓ε073214↓ε111541␈A013260 00014 IF ¬FTSW THEN SCL2←BITS(IC,12,22);
␈B↓ε107356↓ε072734↓ε107152β∧LAND␈A013266 00015 PRP←PFPTR[KADR] LAND '7777;
␈Bβ¬WHILE↓ε107356βαDO␈A013270 00016 WHILE PRP DO
␈Bβ¬BEGIN
∧PRPL␈A013270 00017 BEGIN "PRPL"
␈B↓ε071577↓ε073214↓ε072721↓ε107356␈A013300 00018 PROT←BITS(PFPRO[PRP],24,35);
␈B↓ε071640↓ε072660↓ε071577␈A013306 00019 AD0←PPTRL[PROT]-1;
␈B↓ε071612↓ε072632↓ε071577␈A013313 00020 PLIN←PLINES[PROT];
␈B↓ε071625↓ε072645↓ε071577␈A013320 00021 PVER←PVERTS[PROT];
␈B↓ε107343↓ε073214↓ε072721↓ε107356␈A013331 00022 PFP←BITS(PFPRO[PRP],12,23)+1;
␈Bβ¬WHILE↓ε107343βαDO␈A013334 00023 WHILE PFP>1 DO
␈Bβ¬BEGIN
∧PFPL␈A013334 00024 BEGIN "PFPL"
␈B↓ε107404↓ε107226↓ε073214↓ε107330↓ε072747↓ε107343␈A013347 00025 PRL2←PRL1←BITS(IB←PFEAT[PFP],24,33);
␈BβαIF↓ε072072β∧THEN↓ε107404↓ε073214↓ε107330␈A013356 00026 IF ¬FTSW THEN PRL2←BITS(IB,12,21);
␈B¬ε071345βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105153¬ε070544↓ε015167↓ε107152␈A013373 00027 QTRC(CL&"FEAT: "&CVS(KADR)&" SC-LNS: "&
␈B↓ε015167↓ε107200¬ε070605↓ε015167↓ε107371␈A013403 00028 CVS(SCL1)&BL&CVS(SCL2)&
␈B↓ε015167↓ε071577␈A013414 00029 " PROT: "&CVS(PROT)&" PR-LNS: "&
␈B↓ε015167↓ε107226¬ε070605↓ε015167↓ε107404¬ε070544␈A013431 00030 CVS(PRL1)&BL&CVS(PRL2)&CL);
␈B↓ε111465βαIF↓ε072072β∧THEN␈A013433 00031 DIR←IF FTSW THEN
␈B↓ε072556↓ε107445ββLSHβ∧ELSE␈A013441 00032 LFEAT[FTI] LSH -33 ELSE
␈B↓ε073214↓ε107330ββXOR↓ε111554↓ε073214↓ε111541␈A013456 00033 BITS(IB,34,34) XOR (ID←BITS(IC,35,35));
␈B↓ε111526↓ε106705↓ε107200↓ε107226↓ε111465␈A013463 00034 SUCC←MAP(SCL1,PRL1,DIR);
␈B↓ε111643␈A013465 00035 REVER←0;
␈B↓ε107677βαIF↓ε111526↓ε072426β∧LANDβ∧THEN␈A013472 00036 BA1: IF SUCC≥0∧MAPTRC LAND '100 THEN
␈Bβ¬BEGIN␈A013472 00037 BEGIN
␈B↓ε016437¬ε070544␈A013472 00038 OUTSTR(CL&"BEST(MAP) - PROT: "&
␈B↓ε073140↓ε071577¬ε070557↓ε015322↓ε072454↓ε015322↓ε072441¬ε070544␈A013526 00039 PNAME[PROT]QSCOR&CL);
␈B↓ε072222↓ε072324␈A013531 00040 LNCRE0←LNCRE2←1006;
␈B¬ε071317ββFOR↓ε111602β∧STEPβ¬UNTIL↓ε071612βαDO␈A013535 00041 LOOP(I1,1,PLIN,1)
␈B↓ε105331↓ε111732↓ε071727↓ε111602␈A013545 00042 MLCR(LPARTL(CMPIND,I1),1006);
␈B↓ε105726↓ε072426β∧LAND␈A013551 00043 UPPDAL(MAPTRC LAND '200);
␈B↓ε072222↓ε071653␈A013553 00044 LNCRE0←LNCS1;
␈B↓ε072324↓ε071666␈A013555 00045 LNCRE2←LNCS2;
␈B¬ε071317ββFOR↓ε111602β∧STEPβ¬UNTIL↓ε071612βαDO␈A013561 00046 LOOP(I1,1,PLIN,1)
␈B↓ε105550↓ε111732↓ε071727↓ε111602␈A013566 00047 REVIVE(LPARTL(CMPIND,I1))
␈BββEND␈A013570 00048 END;
␈Bβ∧CASE↓ε111526βαOFβ¬BEGINβαGO↓ε107766βαGO↓ε106323ββEND␈A013612 00049 CASE SUCC+1 OF BEGIN GO REV; ; GO ISO; ; END;
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 14-1
PARSE
␈B¬ε071271βπCOMMENT␈A013612 00050
_ PARSE cont;
␈B¬ε071271βπCOMMENT␈A013612 00002 _ We have here a maximal partial mapping for
013612 00003 this key. See if it is a maximal partial
013612 00004 for this iteration of PARSE. If it is,
013612 00005 then save inserted lines at LCREDE=1005.;
013612 00006
␈B↓ε111630↓ε072120␈A013612 00007 I3←¬BESTMP
␈B↓ε111526␈A013614 00008 ∨SUCC=2
␈B↓ε107076↓ε071727β∧LAND␈A013623 00009 ∨PARTS[CMPIND,0] LAND '777777777
␈B↓ε107076↓ε072120β∧LAND␈A013637 00010 > PARTS[BESTMP,0] LAND '777777777;
␈BβαIF↓ε111630β∧THEN␈A013640 00011 IF I3 THEN
␈Bβ¬BEGIN␈A013640 00012 BEGIN
␈B↓ε072120↓ε071727␈A013642 00013 BESTMP←CMPIND;
␈B¬ε071345βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105153¬ε070544¬ε070544␈A013652 00014 QTRC(CL&"New best partial"&CL)
␈BββEND␈A013652 00015 END;
␈B¬ε071317ββFOR↓ε107315β∧STEPβ¬UNTIL↓ε072263βαDO␈A013656 00016 LOOP(IA,1,MAXNOL,1)
␈BβαIF↓ε111615↓ε104734↓ε107315␈A013661 00017 IF (I2←LCRL(IA))=1005
␈B↓ε111630␈A013663 00018 ∧I3
␈B↓ε111615␈A013665 00019 ∨I2=1004
␈B↓ε111630␈A013670 00020 ∧¬I3
␈Bβ∧THEN↓ε105112↓ε107315β∧ELSE␈A013676 00021 THEN LINDL(IA,0) ELSE
␈BβαIF↓ε111630↓ε111615β∧THEN␈A013703 00022 IF I3∧I2=1004 THEN
␈B↓ε072543↓ε107315↓ε072543↓ε107315␈A013715 00023 LCREDE[IA]←LCREDE[IA]+1;
␈BβαIF↓ε111526β∧THENβαGO↓ε106323␈A013721 00024 IF SUCC=2 THEN GO ISO;
␈BβαIF↓ε071727↓ε071727β∧THEN␈A013726 00025 IF (CMPIND←CMPIND+1)>63 THEN
␈Bβ¬BEGIN␈A013726 00026 BEGIN
␈B¬ε071345βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105153¬ε070544␈A013733 00027 QTRC(CL&"Mappings in excess of 63."&
␈B¬ε070544␈A013736 00028 "Isolate best."&CL);
␈BβαGO↓ε106323␈A013737 00029 GO ISO
␈BββEND␈A013737 00030 END;
␈B↓ε107766βαIF↓ε111643↓ε111424β∧THEN␈A013743 00031 REV: IF ¬REVER∧ORD THEN
␈Bβ¬BEGIN␈A013743 00032 BEGIN
␈B↓ε111526↓ε106705↓ε107200↓ε107404βαIF↓ε072072β∧THEN↓ε111465␈A013747 00033 SUCC←MAP(SCL1,PRL2,IF FTSW THEN 1-DIR
␈Bβ∧ELSE↓ε073214↓ε107330ββXOR↓ε111554␈A013763 00034 ELSE BITS(IB,22,22) XOR ID);
␈B↓ε111643␈A013765 00035 REVER←1;
␈BβαGO↓ε107677␈A013766 00036 GO BA1
␈BββEND␈A013766 00037 END;
013766 00038
␈B¬ε071271βπCOMMENT␈A013766 00039 _ Display scene?;
013766 00040
␈BβαIF↓ε111526↓ε072003↓ε072426β∧LANDβ∧THEN␈A013776 00041 IF SUCC+1∧KMP∧MAPTRC LAND '200000 THEN
␈Bβ¬BEGIN␈A013776 00042 BEGIN
␈B↓ε016437¬ε070544␈A014001 00043 OUTSTR(CL&"SCENE");
␈B↓ε105726↓ε072426β∧LAND␈A014005 00044 UPPDAL(MAPTRC LAND '400000)
␈BββEND␈A014005 00045 END;
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 15-1
PARSE
␈B¬ε071271βπCOMMENT␈A014005 00046
_ PARSE cont;
␈B¬ε071271βπCOMMENT␈A014005 00002 _ Parsing process continues normally with next
014005 00003 key ( = scene-line(s) & prototype &
014005 00004 prototype-line(s) combination).;
014005 00005
␈B↓ε107343↓ε072747↓ε107343β∧LAND␈A014010 00006 PFP←PFEAT[PFP] LAND '7777
␈BββEND∞∧PFPL␈A014014 00007 END "PFPL";
␈B↓ε107356↓ε072721↓ε107356β∧LAND␈A014017 00008 PRP←PFPRO[PRP] LAND '7777
␈BββEND∞∧PRPL␈A014023 00009 END "PRPL";
␈B↓ε107254βαIF↓ε072072β∧THEN↓ε072072β∧ELSE↓ε072775↓ε107254β∧LAND␈A014036 00010 CFP←IF FTSW THEN -FTSW ELSE CFEAT[CFP] LAND '7777;
␈BββEND∞∧CFPL␈A014041 00011 END "CFPL";
014041 00012
␈B¬ε071271βπCOMMENT␈A014041 00013 _ Iterate at this point, starting by finding the best
014041 00014 unused key-feature at this stage.;
014041 00015
␈B↓ε072734↓ε107152↓ε072734↓ε107152ββLOR␈A014051 00016 PFPTR[KADR]←PFPTR[KADR] LOR '400000000000;
␈BβαGO↓ε111055␈A014052 00017 GO ITER;
014052 00018
␈B¬ε071271βπCOMMENT␈A014052 00019 _ Use l.f. keys as well, before deciding on mapping.;
014052 00020
␈B↓ε106323βαIF↓ε111526↓ε072072β∧THEN␈A014060 00021 ISO: IF SUCC<1∧FTSW<2 THEN
␈Bβ¬BEGIN␈A014060 00022 BEGIN
␈B↓ε072072↓ε072072␈A014063 00023 FTSW←FTSW+1;
␈B↓ε107417␈A014065 00024 LB←1;
␈B↓ε107432↓ε072365␈A014067 00025 UB←PLFTOT;
␈B↓ε107473↓ε072263␈A014071 00026 UBI←MAXNOL;
␈B↓ε107371↓ε107404↓ε111567␈A014075 00027 SCL2←PRL2←MXMXCM←0;
␈BβαIF↓ε072072β∧THEN¬ε071317ββFOR↓ε107315β∧STEPβ¬UNTIL↓ε072365βαDO↓ε072734↓ε107315␈A014105 00028 IF FTSW=2 THEN LOOP(IA,1,PLFTOT,1) PFPTR[IA]←
␈B↓ε072734↓ε107315β∧LAND␈A014114 00029 PFPTR[IA] LAND '377777777777;
␈B¬ε071345βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105153β∧CASE↓ε072072βαOF¬ε070544␈A014152 00030 QTRC((CASE FTSW OF("L","L","P"))&"F-keys"&CL);
␈BβαGO↓ε111055␈A014153 00031 GO ITER
␈BββEND␈A014153 00032 END;
014153 00033
␈B¬ε071271βπCOMMENT␈A014153 00034 _ Isolation of partial (or complete) object.;
␈B¬ε071271βπCOMMENT␈A014153 00035 _ First check if the parsing process is at an end.;
014153 00036
␈BβαIF↓ε072120↓ε111526β∧THEN␈A014157 00037 IF ¬BESTMP∧¬SUCC THEN
␈Bβ¬BEGIN␈A014157 00038 BEGIN
␈B¬ε071345βαIF↓ε071770↓ε072426β∧LANDβ∧THEN↓ε105153¬ε070544¬ε070544␈A014167 00039 QTRC(CL&"SCENE EXHAUST ED - END OF PARSE"&CL);
␈B↓ε071770↓ε072426␈A014172 00040 DTRACE←MAPTRC←0;
␈BβαIF↓ε071770β∧THENβ¬BEGIN↓ε015260↓ε071551↓ε071551ββEND␈A014177 00041 IF DTRACE THEN BEGIN CLOSE(DCHAN); DCHAN←-1;END;
␈BβεRETURN␈A014177 00042 RETURN
␈BββEND␈A014202 00043 END;
014202 00044
␈B¬ε071271βπCOMMENT␈A014202 00045 _ There is a partial or complete. Save mapping.;
014202 00046
␈B↓ε111615βαIF↓ε111526β∧THEN↓ε071727β∧ELSE↓ε072120␈A014211 00047 I2← IF SUCC=1 THEN CMPIND ELSE BESTMP;
␈B¬ε071317ββFOR↓ε111602β∧STEPβ¬UNTIL↓ε111656βαDO↓ε107076↓ε071564↓ε111602↓ε107076↓ε111615↓ε111602␈A014231 00048 LOOP(I1,0,PARTSI,1) PARTS[CURMAP,I1]←PARTS[I2,I1];
MAPS1 SAIL 17-SEP-73 13:23 MAPS1 16-1
PARSE
␈B¬ε071271βπCOMMENT␈A014231 00049
_ PARSE cont;
014231 00002
␈B¬ε071271βπCOMMENT␈A014231 00003 _ Now truck object off to LCREDE=2000+2*CURMAP.;
014231 00004
␈B↓ε071727↓ε071564␈A014235 00005 CMPIND←2000+2*CURMAP;
␈B↓ε111615↓ε072632↓ε072146↓ε107076↓ε071564ββLSH␈A014250 00006 I2←PLINES[N1←PARTS[CURMAP,0] LSH -30];
␈B¬ε071317ββFOR↓ε111602β∧STEPβ¬UNTIL↓ε111615βαDO↓ε105331↓ε111630↓ε111732↓ε071564↓ε111602↓ε071727↓ε104734↓ε111630␈A014274 00007 LOOP(I1,1,I2,1) MLCR(I3←LPARTL(CURMAP,I1),CMPIND+(LCRL(I3)≠1004));
␈BβαIF↓ε072426β∧LANDβ∧THEN␈A014277 00008 IF MAPTRC LAND '400 THEN
␈Bβ¬BEGIN␈A014277 00009 BEGIN
␈B↓ε016437¬ε070544↓ε073140↓ε072146¬ε070557↓ε015322↓ε072454↓ε015322↓ε072441¬ε070544␈A014333 00010 OUTSTR(CL&"BEST(PARSE) - PROT: "&PNAME[N1]QSCOR&CL);
␈B↓ε072222↓ε072324␈A014336 00011 LNCRE0←LNCRE2←1006;
␈B¬ε071317ββFOR↓ε111602β∧STEPβ¬UNTIL↓ε111615βαDO↓ε105331↓ε111732↓ε071564↓ε111602␈A014352 00012 LOOP(I1,1,I2,1) MLCR(LPARTL(CURMAP,I1),1006);
␈B↓ε105726↓ε072426β∧LAND␈A014356 00013 UPPDAL(MAPTRC LAND '1000);
␈B↓ε072222↓ε071653␈A014360 00014 LNCRE0←LNCS1;
␈B↓ε072324↓ε071666␈A014362 00015 LNCRE2←LNCS2;
␈B¬ε071317ββFOR↓ε111602β∧STEPβ¬UNTIL↓ε111615βαDO↓ε105550↓ε111732↓ε071564↓ε111602␈A014373 00016 LOOP(I1,1,I2,1) REVIVE(LPARTL(CURMAP,I1))
␈BββEND␈A014375 00017 END;
014375 00018
␈B¬ε071271βπCOMMENT␈A014375 00019 _ Finally clean up the scene, shipping all replaced lines
014375 00020 (partial lines belonging to the object but superceded as members
014375 00021 of the mapping) into oblivion at LCREDE=3000+CURMAP;
014375 00022
␈B↓ε106412␈A014376 00023 CLUPSC;
␈BβαIF↓ε072426β∧LANDβ∧THEN␈A014401 00024 IF MAPTRC LAND '4000000 THEN
␈Bβ¬BEGIN␈A014401 00025 BEGIN
␈B↓ε072311␈A014403 00026 LNCRE1←1;
␈B↓ε072324␈A014405 00027 LNCRE2←4000;
␈B↓ε104530␈A014407 00028 REGREF(11);
␈B↓ε072311↓ε071653␈A014411 00029 LNCRE1←LNCS1;
␈B↓ε072324↓ε071666␈A014413 00030 LNCRE2←LNCS2;
␈BββEND␈A014413 00031 END;
014413 00032
␈B¬ε071271βπCOMMENT␈A014413 00033 _ Now the scene may have changed in some relevant way, so before
014413 00034 going through a renewed cross-reference investigation and
014413 00035 feature-extraction, and continuing the parse, we perform an
014413 00036 UNXREF to detach topologically all removed or transferred lines.;
014413 00037
␈B↓ε073563␈A014414 00038 UNXREF;
␈BβαGO↓ε110116␈A014415 00039 GO REP
␈BββEND∞¬PARSE ε111055∧ITER ε110116βREP ε107766βREV ε106323βISO ε107677βBA1 ε107111¬PLMAP ε107302¬PVMAP ε107076¬PARTS ε107124εFLMAPS ε107267εMAXCOM ε107315αIA ε107330αIB ε107152∧KADR ε107343βPFP ε107254βCFP ε107356βPRP ε107200∧SCL1 ε107371∧SCL2 ε107226∧PRL1 ε107404∧PRL2 ε107417αLB ε107432αUB ε107445βFTI ε107473βUBI ε111465βDIR ε111513βIBB ε111376βICC ε111424βORD ε111526∧SUCC ε111541αIC ε111554αID ε111567εMXMXCM ε111602αI1 ε111615αI2 ε111630αI3 ε111643¬REVER ε111656εPARTSI ε111671εKLST.. ε111704εLPARTS ε111732εLPARTL∞¬PARSE␈A014512 00040 END "PARSE";
␈BββEND∞¬MAPS1 ε070325εKLST.. ε070401αQC ε070414βQCO ε070427βQCR ε070455πNOTHING ε070544αCL ε070557¬QSCOR ε070605αBL ε070633∧QENP ε070661αQS ε070707∧QESP ε070735αQI ε070763αQR ε071011βQRI ε071037βQRR ε071065βQEP ε071113∧QEIP ε071141∧QERP ε071167∧QFOP ε071215¬QFOIP ε071243¬QFORP ε071271↓. ε071317∧LOOP ε071345∧QTRC ε071421∧DTRC ε071373εLINSET ε071447εBELCRE ε071475¬SAFEX ε071510αIA ε071551¬DCHAN ε071564εCURMAP ε071577∧PROT ε071612∧PLIN ε071625∧PVER ε071640βAD0 ε071653¬LNCS1 ε071666¬LNCS2 ε071701∧RAYS ε071714βICH ε071727εCMPIND ε071742∧BRCH ε071755βEOF ε071770εDTRACE ε072003βKMP ε072016βRUL ε072031¬MDCTR ε072044∧DISW ε072057εFLMIND ε072072∧FTSW ε072105¬LFDBT ε072120εBESTMP ε072133∧NPRS ε072146αN1 ε072161αN2 ε072174αTC ε072207βTCS ε072222εLNCRE0 ε072235¬NOEPA ε072250βNOL ε072263εMAXNOL ε072276εMAXNOV ε072311εLNCRE1 ε072324εLNCRE2 ε072337¬PFTOT ε072352¬MODIF ε072365εPLFTOT ε072400εMAXPLS ε072413εMAXPVS ε072426εMAPTRC ε072441βSCO ε072454∧CMPL ε072467∧RWIC ε072502∧RMAP ε072515∧DICH ε072543εLCREDE ε072556¬LFEAT ε072571εLVERCO ε072604∧LINK ε072617εLVERSI ε072632εPLINES ε072645εPVERTS ε072660¬PPTRL ε072673¬PLINE ε072706εPLINE2 ε072721¬PFPRO ε072747¬PFEAT ε072762∧LVER ε072775¬CFEAT ε072734¬PFPTR ε073010¬XVCOR ε073023¬YVCOR ε073036¬XLCOR ε073051¬YLCOR ε073064βCXL ε073077βCYL ε073112βCCL ε073125∧RLEN ε073140¬PNAME ε073153εLINDEL ε073214∧BITS ε073270πMAPCONV ε073357¬INREK ε073420εUPPDAT ε073474∧FTEX ε073522¬XREFC ε073563εUNXREF ε073624∧LACT ε073652εANGLIN ε073713¬LVOPP ε073767∧SQRT ε074030∧MAX0 ε103727∧KARN ε104003¬REKOP ε104174εWEIGHV ε104324εMAPREC ε104426εPRECAL ε104454∧CALC ε104502εLVNEXT ε104530εREGREF ε104604εMSCVCO ε104645εNEXVER ε104734∧LCRL ε104762∧LCRV ε105023¬DTRCE ε105112¬LINDL ε105153¬QTRCE ε105331∧MLCR ε105550εREVIVE ε105726εUPPDAL ε106056¬UNTST ε106160¬BREAK ε106412εCLUPSC ε106453εFUSABL ε107007¬LFDIF ε106705βMAP ε107725¬PARSE ε015035βOUT ε015113∧OPEN ε015167βCVS ε015260¬CLOSE ε015322∧CVOS ε015335¬ENTER ε016051εARRBLT ε016235εINCHRW ε016315¬INSTR ε016437εOUTSTR ε016467πGETCHAN␈A015170 00041 END "MAPS1";